module SExpressions where

import qualified ResultState as RS
import qualified Data.Char as Char
import Control.Monad.Trans.State.Lazy
import qualified Reader as R
import Result
import Data.List


type Range loc = (loc, loc)

type Reader loc a = R.Reader Char loc a

data SExpression loc = Symbol String (Range loc)
                     | Integer Integer (Range loc)
                     | String String (Range loc)
                     | Keyword String (Range loc)
                     | List [SExpression loc] (Range loc)


instance Show (SExpression loc) where
    show (Symbol str _)  = str
    show (Integer n _)   = show n
    show (String s _)    = "\"" ++ s ++ "\""
    show (Keyword s _)   = ':' : s
    show (List sexpr _)  = "(" ++ intercalate " " (map show sexpr) ++ ")"


special :: Char -> Bool
-----------------------
special c = Char.isSpace c || c `elem` "()"


withRange :: Reader loc a -> Reader loc (a, Range loc)
------------------------------------------------------
withRange reader = do start <- R.position
                      result <- reader
                      end <- R.position
                      return (result, (start, end))


integer :: Reader loc (SExpression loc)
---------------------------------------
integer = do ((sign, digits), range) <- withRange (do sign <- R.optional (== '-') '+'
                                                      digits <- R.many1 (R.single Char.isDigit)
                                                      return (sign, digits))
             R.choice [ R.ignore $ R.expect special
                      , R.ignore $ R.eof
                      ]
             case sign of
               '-' -> return $ Integer (- (read digits)) range
               '+' -> return $ Integer (read digits) range


string :: Reader loc (SExpression loc)
--------------------------------------
string = do (chars, range) <- withRange $ do R.single (== '"')
                                             chars <- R.many (R.single (/= '"'))
                                             R.single (== '"')
                                             return chars
            return $ String chars range


keyword :: Reader loc (SExpression loc)
---------------------------------------
keyword = do (chars, range) <- withRange $ do R.single (== ':')
                                              R.many1 (R.single (not . special))
             return $ Keyword chars range


symbol :: Reader loc (SExpression loc)
--------------------------------------
symbol = do (chars, range) <- withRange $ R.many1 (R.single (not . special))
            return $ Symbol chars range


whitespace :: Reader loc ()
---------------------------
whitespace = do R.many (R.single Char.isSpace)
                return ()


quote :: Reader loc (SExpression loc)
-------------------------------------
quote = do start <- R.position
           R.single (== '\'')
           middle <- R.position
           x <- token
           end <- R.position
           return $ List [ Symbol "quote" (start, middle), x ] (start, end)


quasiquote :: Reader loc (SExpression loc)
------------------------------------------
quasiquote = do start <- R.position
                R.single (== '`')
                middle <- R.position
                x <- token
                end <- R.position
                return $ List [ Symbol "quasiquote" (start, middle), x ] (start, end)


unquote :: Reader loc (SExpression loc)
---------------------------------------
unquote = do start <- R.position
             R.single (== ',')
             middle <- R.position
             x <- token
             end <- R.position
             return $ List [ Symbol "unquote" (start, middle), x ] (start, end)


splice :: Reader loc (SExpression loc)
--------------------------------------
splice = do start <- R.position
            R.single (== ',')
            R.single (== '@')
            middle <- R.position
            x <- token
            end <- R.position
            return $ List [ Symbol "splice-unquote" (start, middle), x ] (start, end)


token :: Reader loc (SExpression loc)
-------------------------------------
token = R.choice [ integer
                 , string
                 , keyword
                 , list
                 , quote
                 , quasiquote
                 , splice
                 , unquote
                 , symbol
                 ]


list :: Reader loc (SExpression loc)
------------------------------------
list = do (xs, range) <- withRange $ do R.single (== '(')
                                        xs <- token `R.separatedBy` whitespace
                                        R.single (== ')')
                                        return xs
          return $ List xs range


parse :: [(Char, loc)] -> Maybe [SExpression loc]
-------------------------------------------------
parse input = case R.parse aux input of
                Success a -> Just a
                Failure _ -> Nothing
    where
      aux = do xs <- token `R.separatedBy` whitespace
               whitespace
               R.eof
               return xs


class AsSExpr a where
    asSExpr :: a -> SExpression ()
